﻿Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared

Public Class frmEmail
    Public pRubrique As String
    Public pNoDossier As Integer
    Public pReport As String

    Private szSQL As String
    Private rs As ADODB.Recordset = Nothing

    Private Sub frmEmail_Load(sender As Object, e As System.EventArgs) Handles Me.Load

        Dim szNomPDF As String = ""
        Dim szCheminRPT As String = ""
        Dim szCriteresRPT As String = ""

        'générer l'état .rpt en fichier .PDF
        szNomPDF = pReport.Substring(0, pReport.Length - 4) & Format(pNoDossier, "000000") & ".pdf"
        Me.Text = "Envoyer " & szNomPDF
        TE_ATTACHED.Text = My.Settings.DossierRoot & "EXPORT\" & szNomPDF

        szCheminRPT = My.Settings.DossierRoot & "REPORT\" & pReport
        szCriteresRPT = "{" & pRubrique & ".societe}='" & gSocieteCode & "' AND {" & pRubrique & ".NO_ID} = " & pNoDossier

        ' OUVERTURE du REPORT
        Dim rpt As New ReportDocument
        Try
            rpt.Load(szCheminRPT)
        Catch ex As Exception
            MsgBox(ex.Message & " : " & vbCrLf & szCheminRPT, vbCritical)
            Exit Sub
        End Try

        Dim CrExportOptions As ExportOptions
        Dim CrDiskFileDestinationOptions As New DiskFileDestinationOptions()
        Dim CrFormatTypeOptions As New PdfRtfWordFormatOptions()
        CrDiskFileDestinationOptions.DiskFileName = TE_ATTACHED.Text
        CrExportOptions = rpt.ExportOptions
        With CrExportOptions
            .ExportDestinationType = ExportDestinationType.DiskFile
            .ExportFormatType = ExportFormatType.PortableDocFormat
            .DestinationOptions = CrDiskFileDestinationOptions
            .FormatOptions = CrFormatTypeOptions
        End With
        rpt.RecordSelectionFormula = szSQL
        rpt.Export()

        'Lire le dossier
        szSQL = "CALL spGET_DOSSIER_EMAIL('" & gSocieteCode & "','" & pRubrique & "'," & pNoDossier & ")"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        If rs.RecordCount > 0 Then
            TE_A1.Text = rs.Fields("c_email").Value
            TE_A2.Text = rs.Fields("email").Value
        Else
            TE_A1.Text = ""
            TE_A2.Text = ""
        End If

        rs.Close()

        TE_EXPEDITEUR.Text = My.Settings.EmailFrom
        ' TE_CC.Text = My.Settings.EmailCC
        TE_A1.Text = getEmail()
        TE_Objet.Text = "[SAS DUMAS] " & pRubrique & " no " & Format(gNoDossier, "000000")

        TE_MESSAGE.Text = "Madame, Monsieur, " & vbCrLf & vbCrLf & _
                          "Veuillez trouver ci-joint le fichier " & szNomPDF & "." & vbCrLf & vbCrLf & _
                          "Cordialement," & vbCrLf & vbCrLf & _
                          "Entreprise Dumas"

    End Sub

    Private Function getEmail()

        getEmail = ""
        rs.Close()

    End Function



    Private Sub BO_ENVOYER_Click(sender As System.Object, e As System.EventArgs) Handles BO_ENVOYER.Click

        'Controler l'adresse du destinataire
        If TE_A1.TextLength = 0 Or TE_OBJET.TextLength = 0 Then
            MsgBox("L'adresse du destinataire ou l'objet ne peut être vide", vbExclamation)
            TE_A1.Focus()
            Exit Sub
        End If

        Call SendEmail(TE_EXPEDITEUR.Text, TE_OBJET.Text, TE_MESSAGE.Text, TE_A1.Text, TE_A2.Text, TE_ATTACHED.Text)

    End Sub

    Private Sub SendEmail(szFrom As String, szSubjet As String, szBody As String, szToAdresse1 As String, szToAdresse2 As String, szAttached As String)

        Dim mailman As New Chilkat.MailMan()
        Dim success As Boolean

        ' Unlocks the component Chilkat : 1-Developer Email License
        If (mailman.UnlockComponent("CAESDUMAILQ_ReHqeuNs6R0e") <> True) Then
            MsgBox("Licence du composant Chilkat non valide !", MsgBoxStyle.Critical, "Envoi de notification par email")
            End
        End If

        ' Set the SMTP server/login/password (if required)
        mailman.SmtpHost = My.Settings.SmtpHost
        mailman.SmtpUsername = My.Settings.SmtpUsername
        mailman.SmtpPassword = My.Settings.SmtpPassword

        ' Create a new email object
        Dim email As New Chilkat.Email()

        email.Subject = szSubjet
        email.SetHtmlBody(szBody)
        email.From = szFrom
        email.AddTo(szToAdresse1, szToAdresse1)
        If szToAdresse2.ToString.Length > 0 Then
            email.AddTo(szToAdresse2, szToAdresse2)
        End If

        '  Add any number of attachments:
        Dim contentType As String

        contentType = email.AddFileAttachment(szAttached)
        If (contentType Is Nothing) Then
            MsgBox(email.LastErrorText)
            Exit Sub
        End If

        '  Update the content-disposition header field for the attachment
        email.AddAttachmentHeader(0, "content-disposition", "inline; filename=""document.pdf""")

        success = mailman.SendEmail(email)
        If (success <> True) Then
            MsgBox(mailman.LastErrorText, MsgBoxStyle.Critical, "Erreur de SendMail")
            Exit Sub
        End If
        '  Some SMTP servers do not actually send the email until
        '  the connection is closed.  In these cases, it is necessary to
        '  call CloseSmtpConnection for the mail to be  sent.
        mailman.CloseSmtpConnection()

    End Sub

End Class